module readfile_module

    use iso_c_binding
    implicit none

    private
    public :: readfile, readfile_c, read_lines, string_t, readfile_b

    type string_t
        character(len=:), allocatable :: s
    end type string_t

    integer, parameter :: max_line = 100000  ! The maximum number of rows
    integer, parameter :: BUFFER_SIZE = 1024

    interface
        subroutine bench() bind(c)
        end subroutine
        subroutine read_text_file(filename, content, length) bind(c, name='readTextFile')
            use iso_c_binding
            character(c_char) :: content(*)
            integer(c_int) :: length
            character(c_char) :: filename(*)
        end subroutine read_text_file
    end interface

contains

    !> readfile method 1
    function readfile_c(fh, filename) result(lines)
        integer, intent(in) :: fh
        character(len=*), intent(in) :: filename
        type(string_t), allocatable :: lines(:)
        character(c_char), allocatable :: file_content(:)
        integer :: i, length, stat, line_count, j
        integer, save :: idx(max_line) = 1
        character(len=BUFFER_SIZE) :: buffer

        inquire (fh, size=length)
        allocate (file_content(length))

        ! read file into a single string
        call read_text_file(filename//c_null_char, file_content, length)
        line_count = 0
        do i = 1, length
            if (file_content(i) == c_new_line) then
                line_count = line_count + 1
                idx(line_count + 1) = i + 1
            end if
        end do

        ! allocate lines from file content string
        allocate (lines(line_count))
        do i = 1, line_count
            allocate (character(idx(i + 1) - idx(i)) :: lines(i)%s)
            do j = idx(i), idx(i + 1) - 1
                lines(i)%s(j - idx(i) + 1:j - idx(i) + 1) = file_content(j)
            end do
        end do

    end function readfile_c

    !> readfile method 2
    function readfile(fh) result(lines)
        integer, intent(in) :: fh
        type(string_t), allocatable :: lines(:)
        character(len=:), allocatable :: file_content
        integer :: i, length, stat, line_count
        integer, save :: idx(max_line) = 1
        character(len=BUFFER_SIZE) :: buffer

        inquire (fh, size=length)
        allocate (character(len=length) :: file_content)

        ! read file into a single string
        line_count = 0
        do
            read (fh, '(a)', iostat=stat) buffer
            if (is_iostat_end(stat)) exit
            line_count = line_count + 1
            length = len_trim(buffer)
            idx(line_count + 1) = idx(line_count) + length
            file_content(idx(line_count):idx(line_count + 1) - 1) = buffer(1:length)
        end do

        ! allocate lines from file content string
        allocate (lines(line_count))
        do i = 1, line_count
            allocate (lines(i)%s, source=file_content(idx(i):idx(i + 1) - 1))
        end do

    end function readfile

    !> readfile method 2
    function readfile_b(fh) result(lines)
        integer, intent(in) :: fh
        type(string_t), allocatable :: lines(:)
        character(len=:), allocatable :: file_content
        integer :: i, length
        integer, allocatable, save :: first(:), last(:)

        inquire (fh, size=length)
        allocate (character(len=length) :: file_content)
        if (length == 0) then
            allocate (lines(0))
            return
        end if

        ! read file into a single string
        read (fh) file_content
        call split_first_last(file_content, c_new_line, first, last)

        ! allocate lines from file content string
        allocate (lines(size(first)))
        do i = 1, size(first)
            allocate (lines(i)%s, source=file_content(first(i):last(i)))
        end do

    end function readfile_b

    !! Author: Milan Curcic
    !! Computes the first and last indices of tokens in input string, delimited
    !! by the characters in set, and stores them into first and last output
    !! arrays.
    pure subroutine split_first_last(string, set, first, last)
        character(*), intent(in) :: string
        character(*), intent(in) :: set
        integer, allocatable, intent(out) :: first(:)
        integer, allocatable, intent(out) :: last(:)

        integer, dimension(len(string) + 1) :: istart, iend
        integer :: p, n, slen

        slen = len(string)

        n = 0
        if (slen > 0) then
            p = 0
            do while (p < slen)
                n = n + 1
                istart(n) = min(p + 1, slen)
                call split_pos(string, set, p)
                iend(n) = p - 1
            end do
        end if

        first = istart(:n)
        last = iend(:n)

    end subroutine split_first_last

    !! Author: Milan Curcic
    !! If back is absent, computes the leftmost token delimiter in string whose
    !! position is > pos. If back is present and true, computes the rightmost
    !! token delimiter in string whose position is < pos. The result is stored
    !! in pos.
    pure subroutine split_pos(string, set, pos, back)
        character(*), intent(in) :: string
        character(*), intent(in) :: set
        integer, intent(in out) :: pos
        logical, intent(in), optional :: back

        logical :: backward
        integer :: result_pos, bound

        if (len(string) == 0) then
            pos = 1
            return
        end if

        !TODO use optval when implemented in stdlib
        !backward = optval(back, .false.)
        backward = .false.
        if (present(back)) backward = back

        if (backward) then
            bound = min(len(string), max(pos - 1, 0))
            result_pos = scan(string(:bound), set, back=.true.)
        else
            result_pos = scan(string(min(pos + 1, len(string)):), set) + pos
            if (result_pos < pos + 1) result_pos = len(string) + 1
        end if

        pos = result_pos

    end subroutine split_pos

    !> Determine number or rows in a file given a LUN
    integer function number_of_rows(s) result(nrows)
        integer, intent(in) :: s
        integer :: ios
        rewind (s)
        nrows = 0
        do
            read (s, *, iostat=ios)
            if (ios /= 0) exit
            nrows = nrows + 1
        end do
        rewind (s)
    end function number_of_rows

    !> read lines into an array of TYPE(STRING_T) variables
    function read_lines(fh) result(lines)
        integer, intent(in) :: fh
        type(string_t), allocatable :: lines(:)

        integer :: i
        integer :: iostat

        allocate (lines(number_of_rows(fh)))
        do i = 1, size(lines)
            call getline(fh, lines(i)%s, iostat)
        end do

    end function read_lines

    !>AUTHOR: fpm(1) contributors
    !!LICENSE: MIT
    !>
    !!##NAME
    !!     getline(3f) - [M_io:READ] read a line of arbintrary length from specified
    !!     LUN into allocatable string (up to system line length limit)
    !!    (LICENSE:PD)
    !!
    !!##SYNTAX
    !!   subroutine getline(unit,line,iostat,iomsg)
    !!
    !!    integer,intent(in)                       :: unit
    !!    character(len=:),allocatable,intent(out) :: line
    !!    integer,intent(out)                      :: iostat
    !!    character(len=:), allocatable, optional  :: iomsg
    !!
    !!##DESCRIPTION
    !!    Read a line of any length up to programming environment maximum
    !!    line length. Requires Fortran 2003+.
    !!
    !!    It is primarily expected to be used when reading input which will
    !!    then be parsed or echoed.
    !!
    !!    The input file must have a PAD attribute of YES for the function
    !!    to work properly, which is typically true.
    !!
    !!    The simple use of a loop that repeatedly re-allocates a character
    !!    variable in addition to reading the input file one buffer at a
    !!    time could (depending on the programming environment used) be
    !!    inefficient, as it could reallocate and allocate memory used for
    !!    the output string with each buffer read.
    !!
    !!##OPTIONS
    !!    LINE    The line read when IOSTAT returns as zero.
    !!    LUN     LUN (Fortran logical I/O unit) number of file open and ready
    !!            to read.
    !!    IOSTAT  status returned by READ(IOSTAT=IOS). If not zero, an error
    !!            occurred or an end-of-file or end-of-record was encountered.
    !!    IOMSG   error message returned by system when IOSTAT is not zero.
    !!
    !!##EXAMPLE
    !!
    !!   Sample program:
    !!
    !!    program demo_getline
    !!    use,intrinsic :: iso_fortran_env, only : stdin=>input_unit
    !!    use,intrinsic :: iso_fortran_env, only : iostat_end
    !!    use FPM_filesystem, only : getline
    !!    implicit none
    !!    integer :: iostat
    !!    character(len=:),allocatable :: line, iomsg
    !!       open(unit=stdin,pad='yes')
    !!       INFINITE: do
    !!          call getline(stdin,line,iostat,iomsg)
    !!          if(iostat /= 0) exit INFINITE
    !!          write(*,'(a)')'['//line//']'
    !!       enddo INFINITE
    !!       if(iostat /= iostat_end)then
    !!          write(*,*)'error reading input:',iomsg
    !!       endif
    !!    end program demo_getline
    !!
    subroutine getline(unit, line, iostat, iomsg)

        !> Formatted IO unit
        integer, intent(in) :: unit

        !> Line to read
        character(len=:), allocatable, intent(out) :: line

        !> Status of operation
        integer, intent(out) :: iostat

        !> Error message
        character(len=:), allocatable, optional :: iomsg

        character(len=BUFFER_SIZE) :: buffer
        character(len=256) :: msg
        integer :: size
        integer :: stat

        allocate (character(len=0) :: line)
        do
            read (unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) &
                & buffer
            if (stat > 0) exit
            line = line//buffer(:size)
            if (stat < 0) then
                if (is_iostat_eor(stat)) then
                    stat = 0
                end if
                exit
            end if
        end do

        if (stat /= 0) then
            if (present(iomsg)) iomsg = trim(msg)
        end if
        iostat = stat

    end subroutine getline

end module readfile_module
